home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / gawk / gawk213s.zoo / gawk-src-2.13 / builtin.c < prev    next >
C/C++ Source or Header  |  1991-06-19  |  23KB  |  1,128 lines
  1. /*
  2.  * builtin.c - Builtin functions and various utility procedures 
  3.  */
  4.  
  5. /* 
  6.  * Copyright (C) 1986, 1988, 1989, 1991 the Free Software Foundation, Inc.
  7.  * 
  8.  * This file is part of GAWK, the GNU implementation of the
  9.  * AWK Progamming Language.
  10.  * 
  11.  * GAWK is free software; you can redistribute it and/or modify
  12.  * it under the terms of the GNU General Public License as published by
  13.  * the Free Software Foundation; either version 1, or (at your option)
  14.  * any later version.
  15.  * 
  16.  * GAWK is distributed in the hope that it will be useful,
  17.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19.  * GNU General Public License for more details.
  20.  * 
  21.  * You should have received a copy of the GNU General Public License
  22.  * along with GAWK; see the file COPYING.  If not, write to
  23.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  */
  25.  
  26. #include "awk.h"
  27.  
  28. #ifndef atarist
  29. extern void srandom P((int seed));
  30. #endif
  31. extern char *initstate P((unsigned seed, char *state, int n));
  32. extern char *setstate P((char *state));
  33. extern long random P((void));
  34.  
  35. extern NODE **fields_arr;
  36. extern int output_is_tty;
  37.  
  38. static NODE *sub_common P((NODE *tree, int global));
  39.  
  40. #ifdef GFMT_WORKAROUND
  41. char *gfmt P((double g, int prec, char *buf));
  42. #endif
  43.  
  44. #ifdef _CRAY
  45. /* Work around a problem in conversion of doubles to exact integers. */
  46. #include <float.h>
  47. #define Floor(n) floor((n) * (1.0 + DBL_EPSILON))
  48. #define Ceil(n) ceil((n) * (1.0 + DBL_EPSILON))
  49.  
  50. /* Force the standard C compiler to use the library math functions. */
  51. extern double exp(double);
  52. double (*Exp)() = exp;
  53. #define exp(x) (*Exp)(x)
  54. extern double log(double);
  55. double (*Log)() = log;
  56. #define log(x) (*Log)(x)
  57. #else
  58. #define Floor(n) floor(n)
  59. #define Ceil(n) ceil(n)
  60. #endif
  61.  
  62. /* Builtin functions */
  63. NODE *
  64. do_exp(tree)
  65. NODE *tree;
  66. {
  67.     NODE *tmp;
  68.     double d, res;
  69. #ifndef exp
  70.     double exp();
  71. #endif
  72.  
  73.     tmp= tree_eval(tree->lnode);
  74.     d = force_number(tmp);
  75.     free_temp(tmp);
  76.     errno = 0;
  77.     res = exp(d);
  78.     if (errno == ERANGE)
  79.         warning("exp argument %g is out of range", d);
  80.     return tmp_number((AWKNUM) res);
  81. }
  82.  
  83. NODE *
  84. do_index(tree)
  85. NODE *tree;
  86. {
  87.     NODE *s1, *s2;
  88.     register char *p1, *p2;
  89.     register int l1, l2;
  90.     long ret;
  91.  
  92.  
  93.     s1 = tree_eval(tree->lnode);
  94.     s2 = tree_eval(tree->rnode->lnode);
  95.     force_string(s1);
  96.     force_string(s2);
  97.     p1 = s1->stptr;
  98.     p2 = s2->stptr;
  99.     l1 = s1->stlen;
  100.     l2 = s2->stlen;
  101.     ret = 0;
  102.     if (IGNORECASE) {
  103.         while (l1) {
  104.             if (l2 > l1)
  105.                 break;
  106.             if (casetable[*p1] == casetable[*p2]
  107.                 && strncasecmp(p1, p2, l2) == 0) {
  108.                 ret = 1 + s1->stlen - l1;
  109.                 break;
  110.             }
  111.             l1--;
  112.             p1++;
  113.         }
  114.     } else {
  115.         while (l1) {
  116.             if (l2 > l1)
  117.                 break;
  118.             if (STREQN(p1, p2, l2)) {
  119.                 ret = 1 + s1->stlen - l1;
  120.                 break;
  121.             }
  122.             l1--;
  123.             p1++;
  124.         }
  125.     }
  126.     free_temp(s1);
  127.     free_temp(s2);
  128.     return tmp_number((AWKNUM) ret);
  129. }
  130.  
  131. NODE *
  132. do_int(tree)
  133. NODE *tree;
  134. {
  135.     NODE *tmp;
  136.     double floor();
  137.     double ceil();
  138.     double d;
  139.  
  140.     tmp = tree_eval(tree->lnode);
  141.     d = force_number(tmp);
  142.     if (d >= 0)
  143.         d = Floor(d);
  144.     else
  145.         d = Ceil(d);
  146.     free_temp(tmp);
  147.     return tmp_number((AWKNUM) d);
  148. }
  149.  
  150. NODE *
  151. do_length(tree)
  152. NODE *tree;
  153. {
  154.     NODE *tmp;
  155.     int len;
  156.  
  157.     tmp = tree_eval(tree->lnode);
  158.     len = force_string(tmp)->stlen;
  159.     free_temp(tmp);
  160.     return tmp_number((AWKNUM) len);
  161. }
  162.  
  163. NODE *
  164. do_log(tree)
  165. NODE *tree;
  166. {
  167.     NODE *tmp;
  168. #ifndef log
  169.     double log();
  170. #endif
  171.     double d, arg;
  172.  
  173.     tmp = tree_eval(tree->lnode);
  174.     arg = (double) force_number(tmp);
  175.     if (arg < 0.0)
  176.         warning("log called with negative argument %g", arg);
  177.     d = log(arg);
  178.     free_temp(tmp);
  179.     return tmp_number((AWKNUM) d);
  180. }
  181.  
  182. /* %e and %f formats are not properly implemented.  Someone should fix them */
  183. /* Actually, this whole thing should be reimplemented. */
  184.  
  185. NODE *
  186. do_sprintf(tree)
  187. NODE *tree;
  188. {
  189. #define bchunk(s,l) if(l) {\
  190.     while((l)>ofre) {\
  191.       erealloc(obuf, char *, osiz*2, "do_sprintf");\
  192.       ofre+=osiz;\
  193.       osiz*=2;\
  194.     }\
  195.     memcpy(obuf+olen,s,(l));\
  196.     olen+=(l);\
  197.     ofre-=(l);\
  198.   }
  199.  
  200.     /* Is there space for something L big in the buffer? */
  201. #define chksize(l)  if((l)>ofre) {\
  202.     erealloc(obuf, char *, osiz*2, "do_sprintf");\
  203.     ofre+=osiz;\
  204.     osiz*=2;\
  205.   }
  206.  
  207.     /*
  208.      * Get the next arg to be formatted.  If we've run out of args,
  209.      * return "" (Null string) 
  210.      */
  211. #define parse_next_arg() {\
  212.   if(!carg) { toofew = 1; break; }\
  213.   else {\
  214.     arg=tree_eval(carg->lnode);\
  215.     carg=carg->rnode;\
  216.   }\
  217.  }
  218.  
  219.     NODE *r;
  220.     int toofew = 0;
  221.     char *obuf;
  222.     int osiz, ofre, olen;
  223.     static char chbuf[] = "0123456789abcdef";
  224.     static char sp[] = " ";
  225.     char *s0, *s1;
  226.     int n0;
  227.     NODE *sfmt, *arg;
  228.     register NODE *carg;
  229.     long fw, prec, lj, alt, big;
  230.     long *cur;
  231.     long val;
  232. #ifdef sun386        /* Can't cast unsigned (int/long) from ptr->value */
  233.     long tmp_uval;    /* on 386i 4.0.1 C compiler -- it just hangs */
  234. #endif
  235.     unsigned long uval;
  236.     int sgn;
  237.     int base;
  238.     char cpbuf[30];        /* if we have numbers bigger than 30 */
  239.     char *cend = &cpbuf[30];/* chars, we lose, but seems unlikely */
  240.     char *cp;
  241.     char *fill;
  242.     double tmpval;
  243.     char *pr_str;
  244.     int ucasehex = 0;
  245.     char signchar = 0;
  246.     int len;
  247.  
  248.  
  249.     emalloc(obuf, char *, 120, "do_sprintf");
  250.     osiz = 120;
  251.     ofre = osiz;
  252.     olen = 0;
  253.     sfmt = tree_eval(tree->lnode);
  254.     sfmt = force_string(sfmt);
  255.     carg = tree->rnode;
  256.     for (s0 = s1 = sfmt->stptr, n0 = sfmt->stlen; n0-- > 0;) {
  257.         if (*s1 != '%') {
  258.             s1++;
  259.             continue;
  260.         }
  261.         bchunk(s0, s1 - s0);
  262.         s0 = s1;
  263.         cur = &fw;
  264.         fw = 0;
  265.         prec = 0;
  266.         lj = alt = big = 0;
  267.         fill = sp;
  268.         cp = cend;
  269.         s1++;
  270.  
  271. retry:
  272.         --n0;
  273.         switch (*s1++) {
  274.         case '%':
  275.             bchunk("%", 1);
  276.             s0 = s1;
  277.             break;
  278.  
  279.         case '0':
  280.             if (fill != sp || lj)
  281.                 goto lose;
  282.             if (cur == &fw)
  283.                 fill = "0";    /* FALL through */
  284.         case '1':
  285.         case '2':
  286.         case '3':
  287.         case '4':
  288.         case '5':
  289.         case '6':
  290.         case '7':
  291.         case '8':
  292.         case '9':
  293.             if (cur == 0)
  294.                 goto lose;
  295.             *cur = s1[-1] - '0';
  296.             while (n0 > 0 && *s1 >= '0' && *s1 <= '9') {
  297.                 --n0;
  298.                 *cur = *cur * 10 + *s1++ - '0';
  299.             }
  300.             goto retry;
  301.         case '*':
  302.             if (cur == 0)
  303.                 goto lose;
  304.             parse_next_arg();
  305.             *cur = force_number(arg);
  306.             free_temp(arg);
  307.             goto retry;
  308.         case ' ':        /* print ' ' or '-' */
  309.         case '+':        /* print '+' or '-' */
  310.             signchar = *(s1-1);
  311.             goto retry;
  312.         case '-':
  313.             if (lj || fill != sp)
  314.                 goto lose;
  315.             lj++;
  316.             goto retry;
  317.         case '.':
  318.             if (cur != &fw)
  319.                 goto lose;
  320.             cur = ≺
  321.             goto retry;
  322.         case '#':
  323.             if (alt)
  324.                 goto lose;
  325.             alt++;
  326.             goto retry;
  327.         case 'l':
  328.             if (big)
  329.                 goto lose;
  330.             big++;
  331.             goto retry;
  332.         case 'c':
  333.             parse_next_arg();
  334.             if (arg->flags & NUMERIC) {
  335. #ifdef sun386
  336.                 tmp_uval = arg->numbr; 
  337.                 uval= (unsigned long) tmp_uval;
  338. #else
  339.                 uval = (unsigned long) arg->numbr;
  340. #endif
  341.                 cpbuf[0] = uval;
  342.                 prec = 1;
  343.                 pr_str = cpbuf;
  344.                 goto dopr_string;
  345.             }
  346.             if (! prec)
  347.                 prec = 1;
  348.             else if (prec > arg->stlen)
  349.                 prec = arg->stlen;
  350.             pr_str = arg->stptr;
  351.             goto dopr_string;
  352.         case 's':
  353.             parse_next_arg();
  354.             arg = force_string(arg);
  355.             if (!prec || prec > arg->stlen)
  356.                 prec = arg->stlen;
  357.             pr_str = arg->stptr;
  358.  
  359.     dopr_string:
  360.             if (fw > prec && !lj) {
  361.                 while (fw > prec) {
  362.                     bchunk(sp, 1);
  363.                     fw--;
  364.                 }
  365.             }
  366.             bchunk(pr_str, (int) prec);
  367.             if (fw > prec) {
  368.                 while (fw > prec) {
  369.                     bchunk(sp, 1);
  370.                     fw--;
  371.                 }
  372.             }
  373.             s0 = s1;
  374.             free_temp(arg);
  375.             break;
  376.         case 'd':
  377.         case 'i':
  378.             parse_next_arg();
  379.             val = (long) force_number(arg);
  380.             free_temp(arg);
  381.             if (val < 0) {
  382.                 sgn = 1;
  383.                 val = -val;
  384.             } else
  385.                 sgn = 0;
  386.             do {
  387.                 *--cp = '0' + val % 10;
  388.                 val /= 10;
  389.             } while (val);
  390.             if (sgn)
  391.                 *--cp = '-';
  392.             else if (signchar)
  393.                 *--cp = signchar;
  394.             if (prec > fw)
  395.                 fw = prec;
  396.             prec = cend - cp;
  397.             if (fw > prec && !lj) {
  398.                 if (fill != sp && (*cp == '-' || signchar)) {
  399.                     bchunk(cp, 1);
  400.                     cp++;
  401.                     prec--;
  402.                     fw--;
  403.                 }
  404.                 while (fw > prec) {
  405.                     bchunk(fill, 1);
  406.                     fw--;
  407.                 }
  408.             }
  409.             bchunk(cp, (int) prec);
  410.             if (fw > prec) {
  411.                 while (fw > prec) {
  412.                     bchunk(fill, 1);
  413.                     fw--;
  414.                 }
  415.             }
  416.             s0 = s1;
  417.             break;
  418.         case 'u':
  419.             base = 10;
  420.             goto pr_unsigned;
  421.         case 'o':
  422.             base = 8;
  423.             goto pr_unsigned;
  424.         case 'X':
  425.             ucasehex = 1;
  426.         case 'x':
  427.             base = 16;
  428.             goto pr_unsigned;
  429.     pr_unsigned:
  430.             parse_next_arg();
  431.             uval = (unsigned